home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
advcpf.zip
/
DEMOFORT.FOR
< prev
next >
Wrap
Text File
|
1993-01-04
|
2KB
|
60 lines
C FORTRAN DEMO (Calculates Distance between two points in 3D-ROOM.)
C
$INCLUDE:'EX.F'
SUBROUTINE COORD
PARAMETER (CLIPPER='void pascal')
REAL*8 PARND
REAL A(3),B(3),DIST
INTEGER*2 IFHEL,DIM,LNG,ALNGTH,STRLEN
INTEGER*2 WAHR,LOGIN
CHARACTER*7 LABEL(3)
LOGICAL*2 ISA,ISARRY
DATA LABEL/'X-COORD','Y-COORD','Z-COORD'/
C PULL ARRAY's FROM CLIPPER
DO 20 I=1,3
A(I)=PARND(1,I)
B(I)=PARND(2,I)
DIST=DIST+(A(I)-B(I))**2
20 CONTINUE
DIST=SQRT(DIST)
C OUTPUT TO SCREEN, NOT VERY FANCY!
WRITE(*,*) ' Demo for a Clipper Fortran Conenction'
WRITE(*,*) ' (The screen I/O is done by Fortran)'
WRITE(*,*) ' Calculates the Distance between A - B'
WRITE(*,*) ' JOBST HENSIEK'
WRITE(*,210)
210 FORMAT(/,14X,'Point A Point B')
WRITE(*,220) (LABEL(J),A(J),B(J),J=1,3)
220 FORMAT(2X,A7,2X,F7.2,2X,F7.2,/)
C Checks for ARRAY
ISA=ISARRY(1)
C
C GIVES ARRAY LENGTH
DIM=ALNGTH(1)
C
C GET STRING-LENGTH
LNG=STRLEN(LABEL(1)//CHAR(0))
C
C TRANSFORM LOGICAL TO INTEGER IN ORDER TO PASS
WAHR=LOGIN(ISA)
WRITE(*,230) DIST,ISA,DIM,LNG
230 FORMAT(2X,'Distance A - B =',F9.2,//,
*2X,'Check for (1st Para), array: ',L2,/,2X,'Array-Dim: A[] : ',I2,
*/,2X,'String-Length : ',I2)
C CLOSE(6)
C
C PUSH (DOUBLE)DIST back to CLIPPER
CALL STRND(DIST,3)
C
C
C PUSH (LOGICAL(INTEGR))WAHR to CLIPPER
CALL STRL(1,4)
C
C
C RETURN (INTEGER)IFEHL TO CLIPPER
C (PUT INTO X in Clipper.prg)
IFEHL=1
CALL RETNI(IFEHL)
END